perm filename CLUST.SAI[4,ALS] blob
sn#054416 filedate 1973-07-24 generic text, type T, neo UTF8
00010 BEGIN "CLUSTER"
00020 DEFINE ⊂="COMMENT"; ⊂ 5/30/73;
00030 ⊂ This program has been simplified for use in getting
00040 histographs;
00050
00060 DEFINE INSIZ="24";
00070 REQUIRE "BLOCKS.HDR[4,ALS]" SOURCE_FILE;
00080 EXTERNAL STRING PROCEDURE INCHWL;
00090 DEFINE BUFSIZ="1024",CNTSIZ="100";
00100 STRING TFILEI,FILEI,OPT1,MESS,SPONAM;
00110 INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00120 INTEGER ARRAY LFILE[0:'177];
00130 INTEGER CHAN1,CHAN4,CHAN6,EOF,IEOF,FILEC,CHAN2;
00140 INTEGER BPT,SEGCNT,SEGTOT,H,I,J,K,L,Q,ZZ;
00150 INTERNAL INTEGER M,N,P,RATE,FLAG,SEGC,INTOT,HINT,TFLAG,UPCNT;
00160 LABEL STRT,LABELA,LABELB,ZZZZ,FINISH;
00170 INTEGER ARRAY COUNT[0:63,0:63];
00180 PRELOAD_WITH '1000000000,'1000000,'1000,1;
00190 INTEGER ARRAY BIT[0:3];
00200 INTEGER ARRAY GVAL,GFLAG[0:3];
00210 INTEGER ARRAY IX[0:1];
00220 STRING ARRAY IN,GATENA[0:3];
00230 INTEGER M1,M2,M3,M4,N1,N2,N3,N4,POINTL;
00240 INTEGER ARRAY SUMM,SUMN[0:63,0:3];
00250 INTEGER BIN;
00260 INTEGER HINCNT,HCOUNT,HINDEX;
00270 STRING PREHINT;
00280
00290 PRELOAD_WITH
00300 '777777,
00310 '777000777,
00320 '777777000,
00330 '777000000777,
00340 '777000777000,
00350 '777777000000,
00360 '777,
00370 '777000,
00380 '777000000,
00390 '777000000000,
00400 0;
00410 INTEGER ARRAY MASK[0:10];
00420
00430 PRELOAD_WITH
00440 '21,'22,'23,'24,'25,'26,'41,'42,'43,'44,6;
00450 INTEGER ARRAY SYMBOL[0:10];
00460
00470 DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00480 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00490 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00500
00510 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00520 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00530 BOOLEAN NF;
00540 LOOKUP(CHAN,FILENAME,NF);
00550 WHILE NF DO
00560 BEGIN
00570 OUTSTR(CR&LF&"Can't find "&FILENAME&". try [1,VIN], File=");
00580 FILENAME ← INCHWL ;
00590 LOOKUP(CHAN,FILENAME,NF)
00600 END;
00610 END "LOOKIN";
00620
00630 STRING PROCEDURE HEADER;
00640 BEGIN "HEADER"
00650 STRING H1,H2; INTEGER I,J,K;
00660 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1;
00670 HINCNT←HINCNT+1; RETURN(PREHINT) END
00680 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
00690 I←LFILE[HINDEX]; K←LDB(POINT(12,I,23)); J←SEGC-K;
00700 IF I=0 THEN BEGIN PREHINT←"NU"; HCOUNT←999; RETURN(PREHINT) END;
00710 IF J ≥ 0 THEN BEGIN "LATCH" H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
00720 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
00730 IF EQU(H1,H2) THEN BEGIN
00740 OUTSTR(CRLF&"Old HEADER version, refuse to learn");
00750 HCOUNT←999; PREHINT←"NU"; RETURN("NU"); END;
00760
00770 IF H1≠0 THEN BEGIN
00780 PREHINT←H1; HCOUNT←LDB(POINT(12,I,35));
00790 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1;
00800 RETURN(PREHINT); DONE END
00810 ELSE BEGIN PREHINT←"NU"; HCOUNT←LDB(POINT(12,I,35));
00820 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
00830 END "LATCH";
00840 PREHINT←"NU"; RETURN(PREHINT); END "XX";
00850 END "HEADER";
00860
00870 PROCEDURE TOP;
00880 BEGIN
00890 SETFORMAT(2,0); OUT(CHAN2,CRLF&TB&" ");
00900 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00910 IF (J MOD 10)=0 THEN OUT(CHAN2,CVS(J)[1 TO 1]) ELSE
00920 OUT(CHAN2," "); IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
00930 OUT(CHAN2,CRLF&"IN1\IN2"&TB&" ");
00940 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00950 OUT(CHAN2,CVS(J)[2 TO 2]); IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
00960 OUT(CHAN2,CRLF&TB&"+");
00970 FOR J←0 STEP 1 UNTIL 63 DO BEGIN OUT(CHAN2,"-");
00980 IF J≠63 THEN IF (J MOD 8)=7 THEN OUT(CHAN2,"+"); END;
00990
01000 END;
01010
01020 PROCEDURE BOTTOM;
01030 BEGIN
01040 OUT(CHAN2,TB&"+");
01050 FOR J←0 STEP 1 UNTIL 63 DO BEGIN OUT(CHAN2,"-");
01060 IF J≠63 THEN IF (J MOD 8)=7 THEN OUT(CHAN2,"+"); END;
01070 OUT(CHAN2,"+"&CRLF0);
01080 END;
01090
00010 FILEI←"SEG1.T0[77,THO]";UPCNT←3;OPT1←"N";FILEC←0;
00020 CHAN4←4;CHAN6←6; CHAN2←2;CHAN1←1;
00030 OUTSTR("This program produces cluster diagrams of data on T0 files"&crlf);
00040 BIN←16;
00050 HEADIN;
00060 OUTSTR("Four phones or features may be specified"&CRLF);
00070 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "PHIN"
00080 WHILE TRUE DO
00090 IF (GATENA[L]←STRIN("Type Ph or Feature )= "))="" then
00100 BEGIN GFLAG[L]←0; GATENA[L]←"Empty"; DONE END ELSE BEGIN
00110 GFLAG[L]←1; I←CVSIX(GATENA[L]);
00120 FOR J←0 STEP 1 UNTIL 63 DO IF PHLIST[J]=I THEN DONE;
00130 IF J≤63 THEN BEGIN GVAL[L]←PHLIST[J]; DONE END ELSE BEGIN
00140 FOR J←0 STEP 1 UNTIL 35 DO IF FLIST[J]=I THEN DONE;
00150 IF J≤35 THEN BEGIN GVAL[L]←(1 LSH (35-J)); GFLAG[L]←2; DONE END
00160 ELSE OUTSTR("Gate not identified"&CRLF); END;
00170 END; END "PHIN";
00180
00190 OUTSTR("Two input parameters are to be specified"&crlf);
00200 FOR L←0 STEP 1 UNTIL 1 DO BEGIN
00210 WHILE TRUE DO BEGIN
00220 IN[L]←STRIN("Type input name = "); J←CVSIX(IN[L]);
00230 FOR P←0 STEP 1 UNTIL INSIZ-1 DO IF J=INNAM[P] THEN DONE;
00240 IF P<INSIZ THEN BEGIN IX[L]←P;DONE END
00250 ELSE OUTSTR("Not found"&CRLF); END; END; M1←IX[0]; N1←IX[1];
00260
00270 CLOSE(CHAN2); OPEN(CHAN2,"DSK",0,0,'10,0,0,0);
00280 SPONAM←GATENA[0]&".HIS";
00290 ENTER(CHAN2,SPONAM,0);
00300 setformat(1,0);
00310 ⊂ **** MAIN ROUTINE STARTS HERE****;
00320 WHILE TRUE DO BEGIN
00330 STRT: CLOSE(CHAN6);
00340 IF OPT1≠"Y" THEN
00350 IF (TFILEI←STRIN("Data file FFT/LPC ("&FILEI&")="))≠"" THEN
00360 FILEI←TFILEI ELSE OPT1←"Y";
00370 IF FILEI="E" THEN DONE;
00380 IF OPT1="Y" THEN BEGIN FILEC←FILEC+1; SETFORMAT(1,0);
00390 IF FILEC>31 THEN DONE;
00400 FILEI←"SEG"&CVS(FILEC)&".T0[77,THO]"; END;
00410
00420 CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00430 LOOKIN(CHAN4,FILEI); EOF←SEGC←SEGCNT←0;
00440 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00450 IF LFILE[21]=0 THEN DONE; ⊂ No more hints;
00460 HINDEX←21; HCOUNT←HINCNT←0;
00470 SEGTOT←(LFILE[0])*3%128; RATE←LFILE[2];
00480 OUTSTR(" "&FILEI);
00490
00500
00510
00520 WHILE EOF=0 DO BEGIN "DATAIN"
00530 ARRYIN(CHAN4,DATBUF[0],BUFSIZ); ⊂ Get data;
00540 BPT←POINT(6,DATBUF[0],-1);
00550
00560 FOR Q←1 STEP 1 UNTIL BUFSIZ%4 DO BEGIN
00570 SEGC←SEGC+1;
00580 IF SEGC>SEGTOT THEN DONE;
00590
00600 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00610 I←CVSIX(HEADER);
00620 FOR L←0 STEP 1 UNTIL 3 DO BEGIN "XL"
00630 WHILE TRUE DO BEGIN
00640 IF GFLAG[L]=0 THEN DONE ELSE IF GFLAG[L]=1 THEN BEGIN
00650 IF I≠GVAL[L] THEN DONE; END ELSE BEGIN
00660 FOR J←0 STEP 1 UNTIL 63 DO IF I=PHLIST[J] THEN DONE;
00670 IF J>63 THEN DONE ELSE
00680 IF (HLIST[J] LAND GVAL[L])=0 THEN DONE; END;
00690 M←INDAT[M1]; N←INDAT[N1];
00700 COUNT[M,N]←COUNT[M,N]+BIT[L];
00710 SUMM[M,L]←SUMM[M,L]+1; SUMN[N,L]←SUMN[N,L]+1;
00720 DONE END;
00730 END "XL";
00740 END;
00750 IF SEGC>SEGTOT THEN DONE;
00760 END "DATAIN"; CLOSE(CHAN4); END; close(chan4);
00770
00780 FOR L←0 STEP 1 UNTIL 3 DO IF GFLAG[L]≠0 THEN BEGIN "PXL"
00790 OUT(CHAN2,CRLF&"Cluster plot for feature "&GATENA[L]&" with inputs "&
00800 IN[0]&" and "&IN[1]&"."&TB&DATIME&CRLF&LF);
00810 TOP;
00820 OUT(CHAN2,"+ Sums"&CRLF);
00830 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
00840 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
00850 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
00860 Q←(COUNT[M,N] LSH ((L*9)-27)) LAND '777;
00870
00880 IF Q=0 THEN OUT(CHAN2," ") ELSE
00890 IF Q>9 THEN OUT(CHAN2,"&") ELSE
00900 OUT(CHAN2,CVS(Q));
00910 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
00920 SETFORMAT(4,0); OUT(CHAN2,"|"&CVS(SUMM[M,L])&CRLF0);
00930 IF M≠63 THEN IF (M MOD 8)=7 THEN BEGIN OUT(CHAN2,TB&"+");
00932 FOR P←0 STEP 1 UNTIL 63 DO IF (P MOD 8)=7 THEN OUT(CHAN2," +")
00933 ELSE OUT(CHAN2," "); OUT(CHAN2,CRLF0); END;
00934
00935 OUT(CHAN2," ");
00940 END;
00950 BOTTOM;
00960 SETFORMAT(3,0); OUT(CHAN2,"Sums →"&TB&"|");
00970 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00980 OUT(CHAN2,CVS(SUMN[J,L])[1 TO 1]);
00990 IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01000 OUT(CHAN2,CRLF0&TB&"|");
01010 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01020 OUT(CHAN2,CVS(SUMN[J,L])[2 TO 2]);
01030 IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01040 OUT(CHAN2,CRLF0&TB&"|");
01050 FOR J←0 STEP 1 UNTIL 63 DO BEGIN
01060 OUT(CHAN2,CVS(SUMN[J,L])[3 TO 3]);
01070 IF (J MOD 8)=7 THEN OUT(CHAN2," "); END;
01080 OUT(CHAN2,FF); END "PXL";
01090
01100
01110 OUT(CHAN2,CRLF&
01120 "Confusion plot (overlap of features) with inputs "&
01125 IN[0]&" and "&IN[1]&"."&TB&DATIME&crlf&LF&TB&
01130 "Key: 1="&GATENA[0]&" and "&GATENA[1]&CRLF&TB&" "&
01140 "2="&GATENA[0]&" and "&GATENA[2]&CRLF&TB&" "&
01150 "3="&GATENA[0]&" and "&GATENA[3]&CRLF&TB&" "&
01160 "4="&GATENA[1]&" and "&GATENA[2]&CRLF&TB&" "&
01170 "5="&GATENA[1]&" and "&GATENA[3]&CRLF&TB&" "&
01180 "6="&GATENA[2]&" and "&GATENA[3]&CRLF&TB&" ");
01185 OUT(CHAN2,
01190 "A="&GATENA[0]&", "&GATENA[1]&" and "&GATENA[2]&CRLF&TB&" "&
01200 "B="&GATENA[0]&", "&GATENA[1]&" and "&GATENA[3]&CRLF&TB&" "&
01210 "C="&GATENA[0]&", "&GATENA[2]&" and "&GATENA[3]&CRLF&TB&" "&
01220 "D="&GATENA[1]&", "&GATENA[2]&" and "&GATENA[3]&CRLF&TB&" "&
01230 "&= All four of the features"&CRLF&LF);
01240
01250 TOP;
01260 OUT(CHAN2,"+"&CRLF);
01270 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
01280 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
01290 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
01300 Q←COUNT[M,N]; P←0;
01310
01320 IF (Q LAND '000777777777)=0 THEN P←1 ELSE
01330 IF (Q LAND '777000777777)=0 THEN P←1 ELSE
01340 IF (Q LAND '777777000777)=0 THEN P←1 ELSE
01350 IF (Q LAND '777777777000)=0 THEN P←1;
01360 IF P=1 THEN OUT(CHAN2," ") ELSE
01370 FOR L←0 STEP 1 UNTIL 10 DO
01380 IF (Q LAND MASK[L])=0 THEN BEGIN
01390 OUT(CHAN2,CVXSTR(SYMBOL[L])[6 TO 6]); DONE END;
01400 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
01410 OUT(CHAN2,"|"&CRLF0);
01420 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
01430 END;
01440 BOTTOM;
01450 OUT(CHAN2,FF);
01460
01470
01480 OUT(CHAN2,CRLF&"Composite plot showing feature dominance with inputs "
01485 &IN[0]&" and "&IN[1]&"."&TB&DATIME&CRLF&LF
01490 &TB&"Key: 1="&GATENA[0]&CRLF
01495 &TB&" 2="&GATENA[1]&CRLF
01500 &TB&" 3="&GATENA[2]&CRLF
01505 &TB&" 4="&GATENA[3]&CRLF&LF);
01510 TOP;
01520 OUT(CHAN2,"+"&CRLF);
01530 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
01540 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
01550 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
01560 J←COUNT[M,N];
01570 M1←(J LSH -27) LAND '777;
01580 M2←(J LSH -18) LAND '777;
01590 M3←(J LSH -9) LAND '777;
01600 M4←J LAND '777;
01610 Q←0;
01620 IF M1=M2=M3=M4 THEN OUT(CHAN2," ") ELSE BEGIN
01630 IF M1>M2 THEN IF M1>M3 THEN BEGIN
01640 IF M1>M4 THEN Q←1 ELSE Q←4; END ELSE BEGIN
01650 IF M3>M4 THEN Q←3 ELSE Q←4; END ELSE
01660 IF M2≥M1 THEN IF M2>M3 THEN BEGIN
01670 IF M2>M4 THEN Q←2 ELSE Q←4 END ELSE BEGIN
01680 IF M3>M4 THEN Q←3 ELSE Q←4; END;
01690 IF Q=1 THEN BEGIN OUT(CHAN2,"1"); M1←0; END ELSE
01700 IF Q=2 THEN BEGIN OUT(CHAN2,"2"); M2←0; END ELSE
01710 IF Q=3 THEN BEGIN OUT(CHAN2,"3"); M3←0; END ELSE
01720 IF Q=4 THEN BEGIN OUT(CHAN2,"4"); M4←0; END;
01730 COUNT[M,N]←(M1 LSH 27)+(M2 LSH 18)+(M3 LSH 9)+M4;
01740 ⊂ This removes the dominant data from the array
01750 so that submerged data can be shown;
01760 END;
01770 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
01780 OUT(CHAN2,"|"&CRLF0);
01790 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
01800 END;
01810 BOTTOM;
01820 OUT(CHAN2,FF);
01830
01840
01850 FOR L←0 STEP 1 UNTIL 3 DO IF GFLAG[L]≠0 THEN BEGIN "PSXL"
01860 OUT(CHAN2,CRLF&"Submerged data for feature "&GATENA[L]&" with inputs "&
01870 IN[0]&" and "&IN[1]&"."&TB&DATIME&CRLF&LF);
01880 out(chan2,tb&"Features considered are "&GATENA[0]&", "&GATENA[1]&
01890 ", "&GATENA[2]&" and "&GATENA[3]&"."&CRLF&LF);
01900 TOP;
01910 OUT(CHAN2,CRLF);
01920 FOR M←0 STEP 1 UNTIL 63 DO BEGIN
01930 SETFORMAT(2,0); OUT(CHAN2,CVS(M)&TB&"|"); SETFORMAT(1,0);
01940 FOR N←0 STEP 1 UNTIL 63 DO BEGIN
01950 Q←(COUNT[M,N] LSH ((L*9)-27)) LAND '777;
01960
01970 IF Q=0 THEN OUT(CHAN2," ") ELSE
01980 IF Q>9 THEN OUT(CHAN2,"&") ELSE
01990 OUT(CHAN2,CVS(Q));
02000 IF N≠63 THEN IF (N MOD 8)=7 THEN OUT(CHAN2," "); END;
02010 SETFORMAT(4,0); OUT(CHAN2,"|"&CRLF0);
02020 IF M≠63 THEN IF (M MOD 8)=7 THEN OUT(CHAN2,CRLF0);
02030 END;
02040 BOTTOM;
02050 OUT(CHAN2,FF); END "PSXL";
02060 CLOSE(CHAN2);
02070 SPOOL(SPONAM,GETCHAN,0);
02080
02090 END "CLUSTER";